perm filename RHYTH.OLD[XX,LCS]3 blob
sn#217893 filedate 1976-06-22 generic text, type T, neo UTF8
00100 C***** SUBRS RHYTH, SETUP, MARKS, DOTS ********
00200
00300 SUBROUTINE RHYTH
00400 COMMON/RINP/R(10,80),POSNT(0/99)
00410 COMMON/RMOD/RMODE2,SET4,IBEAM,NOSET,STEM,STUP,NTC,
00455 1 PS2,RA,RDD,ITB,POSB
00500 COMMON/DPY/ST(4000),WDS(250),MEDIT,GO /XRN/RN(2000)
00600 COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
00700 COMMON /SCX/RHY(4),JALPHA(30),JX,JXX,JZ,IRHY,JD,KA,KB,IZ
00800 COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,
00810 1 NFLG,IXX,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
00900 CCC 1 NFLG,IXX,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA /FLM/RPOS(2,300)
00950 DIMENSION RPOS(2,100)
01000 COMMON/ALF/INP(59),NX,NOTE,JSET,KZ,KX,AVGPOS,RLPOS,RLP2,
01100 1 AVP2,ZX,RE,ZZ,RD,RSTX
01200 C SEE ALSO FILLMS, SETLET AND SETUP RE. /FLM/
01300 COMMON /POS/POS1,POS2 /STF/RSTFAC(-3/4),RSTJ3
01400 EQUIVALENCE (VX(1),X),(VX(2),Y),(VX(7),Z),(RPOS,ST(3400))
01500 1,(VX(3),AB),(VX(4),T),(VX(5),RB),(VX(6),X2)
01600 1,(VX(8),C),(VX(9),S),(VX(10),X3)
02000
02100 DATA FIB/.75/
02200 C FIB IS FOR PSUEDO-FIBONACCI SPACING
02300 RSTJ3=RSTFAC(IFIX(STAFF))
02400 NX=-1
02500 JX=0
02600 NOTE=0
02700 Y=0
02800 NOSET=0
02900 JSET=0
03000 C STUP IS NEG. IF SETUP IS NOT READY
03100 IF(STUP)GO TO 341
03200 IF(SET4.EQ.STAFF)NOSET=-1
03300 C TO ADD MORE NOTES ON SETUP LINE. WIPES OUT P9 AT END OF SCMSS.
03400 KZ=1
03500 POS2=PS2
03600 C GETS LAST ↑↑ POS. FROM SETUP
03700 JSET=-1
03800 C NEXT NUM.(100) IS LIMIT FOR STF.4 (CAN BE UP TO 300-SEE /FLM/)
03900 DO 9 KX=1,100
04000 9 IF(RPOS(2,KX).GE.0)GO TO 10
04100 10 AVGPOS=RPOS(1,KX)
04200 RLPOS=AVGPOS
04300 KX=KX+1
04400 RLP2=RPOS(1,KX)
04500 343 AVP2=RPOS(2,KX)-.001
04600 IF(AVP2.GT.0)GO TO 341
04700 KX=KX+1
04800 GO TO 343
04900 C AVERAGED AND REAL POSITIONS FROM 'SETUP'
05000
05100 C NEXT FOR NON-SETUP
05200 341 DO 34 K=1,IRHY
05300 Z=ABS(V(K))
05400 CC34 IF(V(K).GT..05)Y=ABS(V(K))+Y
05500 C 88TH NOTES ARE TAKEN AS GRACE NOTES. THEN BECOME 32NDS.
05600 IF(Z.NE.4./88.)GO TO 345
05700 IF(JSET)GO TO 34
05800 C GRACE NOTES SKIPPED IN AUTOMATIC SETUP
05900 CF Y=Y+.125
06000 CF GO TO 34
06100 CF345 Y=ABS(V(K))+Y
06200 345 IF(STUP.LT.-1)Z=Z+(.125-Z)*FIB
06300 C STUP CAN BE SET TO .LT.-1 IN NOTBMS FOR PSUEDO-FIBONACCI SPACE
06400 Y=Y+Z
06500 34 CONTINUE
06600 C Y=TOTAL TIME
06700 CX POZ1=POS1
06800 CX POSNT(0)=POS2
06900 C A SAFEGUARD
07000 C SAVES POS1 FOR POSITIONING MF, CRESC. ETC.
07100 NTC=0
07200 C THE WORD COUNT FOR REAL NOTES.
07300 IF(JSET)GO TO 3421
07400
07500 IF(POS1.LT.POS2)POSX=POS1
07600 C SAVES IT FOR BACKUP
07700 IF(POS1.GE.POS2)POS1=POSX
07800
07900 Z=POS2-POS1
08000 ZX=Z
08100 342 DO 1 K=1,IZ
08200 X=R(1,K)
08300 IF(X.LT.3.)GO TO 1
08400 C JUMP IF NOTE OR REST
08500 IF(X.NE.17.)GO TO 8
08600 C JUMP IF NOT A KEY SIG.
08700 RA=2.+ABS(R(5,K))*2.0
08800 GO TO 6
08900 8 IF(X.NE.4.)GO TO 81
09000 C NEXT IS FOR BAR LINES
09100 RA=3
09200 J=K+1
09300 RE=R(1,J)
09400 IF(RE.EQ.3.)RA=1.5
09500 C A CLEF
09600 IF(RE.EQ.18)RA=2.5
09700 C A METER
09800 IF(RE.NE.1)GO TO 83
09900 IF(AMOD(R(5,J),10.).NE.0)RA=4.5
10000 C FINDS ACCI ON NEXT NOTE.
10100 83 IF(K.EQ.IZ)RA=0
10200 C END OF STAFF
10300 GO TO 6
10400 82 RA=6
10500 GO TO 83
10600 81 IF(X.EQ.18)GO TO 82
10700 RA=7.
10800 C FOR CLEFS
10900 IF(K.LT.3)RA=9.
11000 C THE FIRST CLEF IS NOT MINI
11100 6 RA=RA*RSTJ3
11200 C SO SPACE WILL DEPEND ON SIZE OF STAFF
11300 Z=Z-RA
11400 R(8,K)=RA
11500 C STORES SPACE NUM THAT MUST BE GIVEN BACK
11600 1 CONTINUE
11700 C SUBTRACTS SPACE FOR CLEF OR BAR. WILL ADD BOTH LATER.
11800 C POS1 AND Z ARE FOR RHYTHMIC SPACING
11900 C SPACE FOR NON-NOTES
12000 134 FORMAT(' **** MISMATCH WITH SPACING STAFF')
12100 3421 K=0
12200 IF(ABS(Y-RA).LE..001)GO TO 3
12300 IF(JSET)TYPE 134
12400
12500 C LOOP TO END
12600 3 K=K+1
12700 C K IS COUNTER
12800 R(7,K)=0
12900 RE=R(1,K)
13000 IF(RE.LE.2.)GO TO 2
13100 RD=R(8,K)
13200 R(8,K)=0
13300 IF(JSET)GO TO 71
13400
13500 7 IF(K.EQ.IZ)POS1=POS2
13600 IF(R(1,K-1).GT.2.)GO TO 73
13700 IF(K.EQ.1)GO TO 73
13800 IF(RE.EQ.4.)GO TO 73
13900 Z=Z+RD/3.
14000 C RETURNS 1/3 OF THE SPACE IF PREV. ITEM IS NOTE OR REST
14100 POS1=POS1-RD/3
14200 C THIS CAN RESULT IN OVERLAP WHICH MUST BE EDITED OUT.!!
14300 73 R(3,K)=POS1
14400 72 POS1=POS1+RD
14500 C ABOVE SECTION LEAVES ROOM FOR CLEF OR BAR
14600 GO TO 337
14700
14800 C 40??? 50???? WHY NOT 100?
14900 71 DO 74 J=KZ,80
15000 74 IF(RE.EQ.-RPOS(2,J))GO TO 75
15100 POS=R(3,K-1)+4
15200 GO TO 76
15300 75 POS=RPOS(1,J)
15400 KZ=J+1
15500 C FOUND SAME TYPE OF ITEM.
15600 76 R(3,K)=POS
15700 GO TO 337
15800
15900 2 JX=JX+1
16000 21 AB=V(JX)
16100 J=9
16200 IF(RE.NE.2)GO TO 121
16300 V(JX)=-AB
16400 C SHOWS RESTS IN AUTO. BEAM SECTION.(ASSUMES REST WAS A + NUMB.)
16500 J=7
16600 121 IF(R(8,K).GE.-1.)R(J,K)=AB
16700 C STORES RHYTH VALUE FOR LATER USE IN PART EXTRACTOR IF NOT CHORD NOTE.
16800 IF(AB.GT..05)GO TO 210
16900
17000 R(3,K)=-1.
17100 CC RA=100
17200 CC T=R(4,K)
17300 CC IF(T)RA=-RA
17400 CC R(4,K)=T+RA
17500 R(4,K)=R(4,K)+100.
17600 C WILL THIS BE OK WITH NOTES BELOW B3 (I.E. NEG POSITIONS.
17700 R(7,K)=1
17800 C FOUND A GRACE NOTE (88TH NOTE)
17900 JZ=1
18000
18100 1211 IF(R(8,K+JZ).GE.0)GO TO 211
18200 J=K+JZ
18300 R(3,J)=-1
18400 C FOR AUTO-SPACING AT 337
18500 R(4,J)=R(4,J)+100.
18600 C MAKE IT A MINI-NOTE
18700 R(8,K)=1000.+ABS(R(4,K)-R(4,J))
18800 C EXTEND THE STEM
18900 JZ=JZ+1
19000 C FOR MORE CHORD NOTES. SHOULD I CHECK FOR END (IZ)?
19100 GO TO 1211
19200 211 IF(JZ.GT.1)GO TO 2211
19300 C DON'T CHANGE STEM DIR. IF A CHORD
19400 R(8,K)=1000
19500 C 1000 IN P8 PUTS IN SLASH ON TAIL
19600 IF(STEM.GE.0)GO TO 2211
19700 RA=R(5,K)
19800 IF(RA.GE.20)R(5,K)=RA-10.
19900 IF(RA.LT.20)R(5,K)=RA+10.
20000 C TURNS STEM OVER. UNLESS STEM DIRECTIONS WERE FIXED.(SU/SD/)
20100 2211 IF(JSET.GE.0)GO TO 3211
20200 K=K+JZ-1
20300 C POS WILL BE SET AT 336
20400 NTC=NTC+1
20500 C UPDATE THE COUNTER FOR IMPORTANT POSITIONS. POSNT SET AT 336
20600 POSNT(NTC)=-1
20700 GO TO 337
20800 3211 AB=.125
20900 C IT USED TO JUMP. NOW MAKES SPACE FOR GRACE NOTES AS 32NDS.
21000 210 RB=0
21100 CC IF(JSET.GE.0.AND.SET4.LT.0)R(8,K)=-AB-1000.*R(8,K)
21200 C FOR AUTOMATIC SETUP
21300 JZ=K
21400 C JZ WILL BE USED NEAR END
21500 3634 IF(AMOD(AB,.1875).EQ.0)GO TO 122
21600 IF(AMOD(AB*10.,1.5).EQ.0)GO TO 122
21700 C .1875 FINDS SINGLE DOTS ON NOTES (.15 FOR QUINTS) (*10 FOR ROUNDOFF!)
21800 IF(AMOD(AB,.4375).NE.0)GO TO 22
21900 T=20
22000 GO TO 322
22100 122 T=10
22200 322 IF(RE.EQ.2.)GO TO 35
22210 IF(R(6,K).LT.20)GO TO 422
22220 T=T+100
22225 C TO SHIFT DOT DOWN 2 STEPS
22230 CC IF(R(6,K).EQ.30)R(6,K)=0
22300 422 R(7,K)=T
22400 C PUTS ONE OR TWO DOTS
22500 GO TO 36
22600
22700 35 R(6,K)=T/10.
22800 C ADDS DOT TO REST.
22900 36 RB=AB/3.
23000 IF(T.NE.1)RB=(4*AB)/7
23100 C TO KEEP TAIL ON DOTTED NOTE
23200
23300 22 POS=POS1
23330 IF(R(6,K).GE.30)R(6,K)=R(6,K)-30
23365 C 30 NEEDED FOR SOME CASES WITH DOTS ON CHORDS.
23400 IF(JSET.EQ.0)GO TO 220
23500
23600 C NEXT IS FOR SETUP
23700 222 IF(NOTE)GO TO 223
23800 C FIRST TIME A NOTE IS FOUND.
23900 NOTE=-1
24000 POS1=RLPOS
24100 Z=POS2-POS1
24200 C RESETS SPACE AVAILABLE, ZZ IS SPACE FOR NON-NOTES
24300 223 IF(POS1.LT.AVP2)GO TO 221
24400 224 KX=KX+1
24500 C???? OCT, 73 IF(NX.EQ.0)GO TO 225
24600 IF(NX)RLP2=RPOS(1,KX)
24700 NX=-1
24800 225 IF(RPOS(2,KX-1))GO TO 227
24900 RLPOS=RPOS(1,KX-1)
25000 AVGPOS=AVP2
25100 227 AVP2=RPOS(2,KX)-.001
25200 IF(AVP2.GT.0)GO TO 223
25300 C 0 IN RPOS=POS. OF NON-NOTE
25400 CC****** WHY NEEDED?? 6/74 *** IF(RLP2.GE.POS1)NX=0
25500 NX=0
25600 CC*****↑↑↑↑ CHANGED FROM ABOVE *** 6/74
25700 GO TO 224
25800 221 POS=(POS1-AVGPOS)*(RLP2-RLPOS)/(AVP2-AVGPOS)+RLPOS
25900 220 R(3,K)=POS
26000 4634 IF(RE.NE.1)GO TO 44
26100 IF(POS.EQ.POSNT(NTC))GO TO 2634
26200 C SKIPS OTHER CHORD NOTES.
26300 NTC=NTC+1
26400 POSNT(NTC)=POS
26500 C SAVES IT FOR NUMBS ABOVE NOTES, ETC.
26600 2634 IF(AB.GE.2)GO TO 4
26700 IF(AB.EQ.1.333333333)GO TO 4
26800 44 L=K+1
26900 IF(R(8,L).GE.0)GO TO 1634
27000 IF(R(1,L).NE.1.)GO TO 1634
27100 C JUMP IF NOT DOUBLE STOP
27200 C DELETES STEM FROM WHOLE NOTE CHORD (NOW DONE IN NOTWRT IF P7=1)
27300 R(3,L)=R(3,K)
27400 K=L
27500 CC R(8,K)=0
27600 GO TO 3634
27700 C LOOPS BACK TO PICK UP MORE CHORD NOTES
27800
27900 C 'WHITENS' HALF, WHOLE AND TRIPLET HALF NOTES.
28000 4 RA=-R(6,K)
28100 IF(RA.EQ.0)RA=-1
28200 IF(AB.LT.4.)GO TO 144
28300 RP=1
28400 IF(AB.GE.8)RP=2
28500 R(7,K)=R(7,K)+RP
28600 C +1=WHOLE NOTE WILL PRINT +2=DBL WHL NT.
28700 CC NOT NEEDED BECAUSE OF ABOVE. RA=-2.
28800 144 R(6,K)=RA
28900 GO TO 44
29000
29100 1634 T=POS1
29200 RP=AB
29300 IF(STUP.LT.-1)RP=AB+(.125-AB)*FIB
29400 C FOR PSUEDO-FIB. SPACING
29500 POS1=RP/Y*Z+POS1
29600 CF POS1=AB/Y*Z+POS1
29700 CZ GO TO 1636
29800 CZ IF(JSET)GO TO 1636
29900 CZ RP=6.
30000 CZ IF(AMOD(R(5,K+1),10.0).EQ.0)RP=3.
30100 C 3 SPACES IF NO ACCID. ON NEXT NOTE, OTHERWISE 6.
30200 CZ RA=POS1-T
30300 CZ RSTX=RP*RSTJ3
30400 CZ IF(RA.GT.RSTX)GO TO 1636
30500 C JUMP IF NOTES ARE FAR ENOUGH APART
30600 CZ RA=RSTX-RA
30700 C THE DIFFERENCE
30800 CZ Z=Z-Z*RA/(POS2-POS1)
30900 C REDUCES TOTAL SIZE Z
31000 CZ POS1=T+RSTX
31050 1636 T=ABS(R(4,K))
31100 IF(T.LT.500.0.AND.T.GE.100.0)GO TO 337
31200 C LEAVE TAILS ON GRACE NOTES ALONE. (NO SKIP WHEN IN MODE 500)
31300 T=0
31400 RA=AB-RB
31500 IF(RA.EQ.4./6.)GO TO 535
31600 IF(RA.EQ.4./7.)GO TO 535
31700 IF(RA.GT..75)GO TO 535
31800 C KEEPS TAILS OFF TRIPLETS, QUINTS, SEPTS.
31900 DO 534 N=1,4
32000 534 IF(RA.LE.RHY(N))T=N
32100 C DELETES STEM FROM WHOLE NOTES. (NOW DONE IN NOTWRT IF P7=1)
32200 535 IF(R(1,JZ).EQ.1.)GO TO 334
32300 CC R(4,JZ)=0
32310 RA=R(4,JZ)
32400 C SETS REST
32410 IF(R(8,JZ).NE.0.1)GO TO 537
32420 T=-4
32430 R(8,JZ)=-2
32435 C -2 CENTERS THE SIGN UNDER THE RIGHT CONDITIONS
32440 GO TO 536
32500 537 IF(AB.LT.2)GO TO 536
32600 T=-1
32700 IF(AB.GE.4)T=-2
32800 IF(AB.GE.8)T=-3
32900 C -1=HLF RST, -2=WHOLE, -3=DBL WHL RST, -4=REPEAT BAR SIGN(./.)
33000 C WON'T DO DOUBLE DOTTED WHOLE NOTES.
33100 536 R(5,JZ)=T
33200 GO TO 337
33300 C******* 4/74 NEW WAY TO FIND TAILS
33400 C OMITS RESTS (REALLY???)
33500 334 R(7,JZ)=T+R(7,JZ)
33600 337 IF(K.LT.IZ)GO TO 3
33700 M=NTC
33800 DO 335 K=IZ,1,-1
33900 IF(R(3,K).GE.0)GO TO 335
34000 IF(K.NE.IZ)GO TO 336
34100 R(3,K)=POS2-4.
34200 GO TO 335
34300 336 N=K-1
34400 1336 RA=R(3,N)
34500 IF(RA.GT.0)GO TO 2336
34600 N=N-1
34700 IF(N.GT.0)GO TO 1336
34800 C GO BACK (IF MORE GRACE NOTES.) TO FIND PREVIOUS BIG NOTE.
34900 2336 T=R(3,K+1)
35000 RB=T-RA
35100 RA=4
35200 IF(RB.LE.4)RA=RB/3.
35300 C IF SPACE IS SMALL USE 1/3 OF IT.
35400 RB=T-RA
35500 C NEXT FOR GRACE NOTE CHORDS
35600 IF(R(8,K+1).GE.0)GO TO 1335
35700 RB=R(3,K+1)
35800 M=M+1
35900 1335 R(3,K)=RB
36000 POSNT(M)=RB
36100 335 M=M-1
36200 K=0
36300 45 K=K+1
36400 C NEXT IS TO ARRANGE DOTS.
36500 IF(R(7,K).LT.10)GO TO 451
36600 RA=R(3,K)
36700 DO 452 M=K+1,IZ
36800 IF(R(3,M).NE.RA)GO TO 453
36900 C JUMP IF NOT CHORD NOTE.
36910 T=R(7,M)
36920 RB=R(4,M)
37000 IF(T.LT.100.)GO TO 452
37100 C JUMP IF NOTE IS NOT ON LEFT SIDE OF UPWARD STEM
37200 IF(RB-R(4,M-1).NE.2)GO TO 452
37300 IF(AMOD(RB,2.).NE.0)R(7,M)=AMOD(T,10.)
37400 C TAKES AWAY DOT IN CERTAIN CASES TO AVOID CONFUSION.
37500 452 CONTINUE
37600 453 K=M-1
37700 451 IF(K.LT.IZ)GO TO 45
37800
37900 N=IZ
38000 IF(JSET)GO TO 13
38100 13 NTC=NTC+1
38200 POSNT(NTC)=200
38300 POSNT(0)=0
38400 IF(IREAD)RETURN
38500 DIMENSION ISU(390)
38600 COMMON R2,JH,CENTR,J2,R3,R4,R5,RJQ(17),J3,JQ(19)
38700 1 /POSI/STFF(-3/4),JJ2,POSQ /FRMT/FQZ(3),IREAD
38800 EQUIVALENCE (ISU,ST(3600)),(J5,JQ(2))
38900 CALL DPYSET(3,ISU,390)
40900 CALL DPYBRT(6)
41000 J2=STAFF
41100 POSQ=STFF(J2)
41200 J5=1
41300 CC RA=-100
41400 R4=20
41500 C R5=0=1 STANDARD SIZE IS USED.
41600 DO 131 K=1,NTC-1
41700 CC IF(R(1,K).NE.1)GO TO 131
41800 CC IF(R(3,K).EQ.RA)GO TO 131
41900 CC RA=R(3,K)
42000 CC R3=RHORZ(RA)
42100 R3=RHORZ(POSNT(K))
42200 CALL PNUM
42300 C GOES TO DRAW A NUMBER OVER A NOTE
42400 J5=J5+1
42500 IF(J5.EQ.10)J5=0
42600 131 CONTINUE
42700 132 CALL DPYOUT(3)
42800 CALL SETPOG(1)
42900 END
43000
43100 C SETUP ALLOWS YOU TO SET UP RHYTHMS ON STAFF 4 FOR SPACING ALL OTHERS.
43200 SUBROUTINE SETUP
43300 INTEGER PWDS
43400 CCC COMMON/FLM/RPOS(2,300) /ALF/JX,X,RD,RNL,RN6,M,A,RB,RC,
43410 COMMON /ALF/JX,X,RD,RNL,RN6,M,A,RB,RC,
43500 1 INP(64) /SCM/V(78),IV,LCNT,STAFF,LIST(200),REND
43600 COMMON /PTR/PWDS(250),ITEM,L,I,IX
43700 COMMON/DPY/ST(4000),WDS(250),MEDIT,GO /XRN/RN(2000)
43800 COMMON/RMOD/RMODE2,SET4,IBEAM,NOSET,STEM,STUP,NTC,
43900 1 ENDP,RA,RDD,ITB,POSB
43905 DIMENSION RPOS(2,100)
43910 EQUIVALENCE (RPOS,ST(3400))
44000
44100 C RHYTHMIC VALUES ARE SAVED IN P9 OF NOTES AND P7 OF RESTS.
44200 STUP=-1
44300 C THIS SENDS INFO TO SUBR. NOTES
44400 IF(SET4.GT.4)RETURN
44500 C **** BE SURE SETUP STAFF HAS SPACE VALUES IN NOTES AND RESTS!!!
44600 IF(ITEM.EQ.0)RETURN
44700 JX=0
44800 CC RNL=0
44900 RA=0
45000 DO 9534 K=1,ITEM
45100 L=PWDS(K)
45200 IF(RN(L+2).NE.SET4)GO TO 9534
45300 RD=RN(L+1)
45400 IF(RD.LT.5)GO TO 5
45500 IF(RD.LT.17)GO TO 9534
45600 5 IF(RD.GT.2)GO TO 6
45700 RC=7
45800 IF(RD.EQ.2)RC=5
45900 IF(RN(L).LT.RC)GO TO 9534
46000 M=9
46100 IF(RD.EQ.2)M=7
46200 IF(RN(L+M).EQ.0)GO TO 9534
46300 C FOR OTHER NOTES ON SPACING STAFF.
46400 IF(RN(L+8).GT.999.)GO TO 9534
46500 C SKIPS MINI-NOTES. BUT TROUBLE IF STEMS CAUSE P8 TO BE ≤ 999.
46600 GO TO 7
46700 C SKIPS 'OTHER' CHORD TONES (I.E. P9=0 IN A NOTE)
46800 6 IF(RD.NE.3)GO TO 8
46900 IF(RN(L).LT.3)GO TO 7
46910 RC=RN(L+5)
46920 IF(RC.GE.100)GO TO 7
47000 IF(RC.GT.3)GO TO 9534
47100 C SKIPS IF NOT A REAL CLEF (+100=MINI CLEF)
47200 GO TO 7
47300 8 IF(RD.NE.4)GO TO 10
47400 IF(RN(L).GT.2)GO TO 9534
47500 C SKIPS IF NOT BARLINE (I.E. ONLY 4 PARAMS)
47600 10 IF(RD.NE.2)GO TO 7
47700 IF(RN(L).LT.5)GO TO 9534
47800 IF(RN(L+7).EQ.0)GO TO 9534
47900 7 JX=JX+1
48000 RPOS(1,JX)=RN(L+3)
48100 IF(RD.GT.2)GO TO 3
48200 C JUMP WHEN TIME VALUES ARE IN P8
48300 RC=RN(L+M)
48400 C FOR VALUES AUTOMATICALLY SET. ALLOWS NON-DUPLE UNITS IN SETUP
48500 277 RA=RA+RC
48600 C SUM OF RHYTHS
48700 GO TO 77
48800 3 RC=-RD
48900 77 RPOS(2,JX)=RC
49000 C RC IS RHYTHMIC VALUE OF NOTE.
49100 9534 CONTINUE
49200 C NEXT PUTS ITEMS IN PROPER ORDER IF THEY WEREN'T ALREADY
49300 C*** 2ND NOTE OF DBL STOP CAN'T!! HAVE RHYTH. VALUE *******
49400 IF(RA.EQ.0)RETURN
49500 C RA=0 MEANS DIDN'T FIND RHYTHMS ON SPACING STAFF.
49600
49700 CALL SORT2(RPOS,JX)
49800 ENDP=200.
49900 IF(RPOS(2,JX))ENDP=RPOS(1,JX)
50000 DO 1 L=1,JX
50100 1 IF(RPOS(2,L).GT.0)GO TO 4
50200 4 RD=RPOS(1,L)
50300 RB=ENDP-RD
50400 C TOTAL SPACE FROM 1ST NOTE TO END OF LINE
50500 RC=RPOS(2,L)
50600 RPOS(2,L)=RD
50700 C REAL AND AVERAGED POSITIONS OF 1ST NOTE ARE THE SAME.
50800 DO 2 K=L+1,JX
50900 RE=RPOS(2,K)
51000 IF(RE)GO TO 2
51100 RD=RC/RA*RB+RD
51200 RC=RE
51300 RPOS(2,K)=RD
51400 2 CONTINUE
51500 C 1,K=REAL POS. 2,K=AVERAGED POS.
51600 C IN RHYTH: POS=(P1-AVG2)*(RL2-RL1)/(AVG2-AVG1)+RL1
51700 JX=JX+1
51800 RPOS(1,JX)=ENDP
51900 RPOS(2,JX)=ENDP
52000 STUP=0
52100 C THIS FOR NOTES AND RHYTH
52200 END
52300
52400 SUBROUTINE MARKS(RA)
52500 COMMON/ALF/INP(72),ML
52600 DIMENSION MKS(13)
52700 DATA MKS/'W','A','F','S','M','T','D','U','H','I','P','C','R'/
52800 EQUIVALENCE (MF,MKS(3)),(MH,MKS(9)),(MP,MKS(11)),(MM,MKS(5))
52900 1,(MC,MKS(12)),(MR,MKS(13)),(MI,MKS(10))
53000 RA=99
53100 DO 16 JM=1,72
53200 16 IF(INP(JM))GO TO 17
53300 C DIDN'T FIND MORE LETTERS
53400 RETURN
53500 17 N=INP(JM)
53600 ML=INP(JM+1)
53700 M=INP(JM+2)
53800 DO 1 K=1,13
53900 1 IF(N.EQ.MKS(K))GO TO 2
54000 C DID NOT FIND A LETTER
54100 RETURN
54200 C 4=W(EDGE),5=A(CCENT),26=FE(RMATA),7=S(TACCATO),9=T(ENUTO)
54300 C 11=D(OWNBOW), 12=U(PBOW),13=H(ARMONIC),14=PL(US),15=TH(ESIS)
54400 C 16=AR(SIS),17=MO(RDANT)
54500 C 18=I(NVRTD MORD), ---,20=TR(ILL), >39=PPP, PP, CRESC., ETC.
54600 C 21=HW (HEAVY WEDGE), 80=ACC(EL.)
54700 2 GO TO(120,10,12,120,4,11,15,15,15,21,12,80,81),K
54800 12 IF(ML.EQ.'L')GO TO 120
54900 C ↑↑↑ PLUS
55000 IF(N.EQ.MF)GO TO 121
55100 RA=42
55200 IF(ML.NE.MP)GO TO 18
55300 RA=41
55400 IF(M.EQ.MP)RA=40
55500 C FOR P, PP, PPP -- 42, 41, 40
55600 GO TO 18
55700 15 IF(ML.EQ.MI)GO TO 82
55800 K=K+1
55850 IF(ML.EQ.MKS(1))K=18
55875 C 'HW' MAKES 21 (EVENTUALLY MAKES CLEF# 44)
55900 120 K=K+3
56000 8 RA=K
56100 C YOU CAN TYPE # OR NAME OF MARK
56200 18 DO 6 JM=1,72
56300 N=INP(JM)
56400 INP(JM)=' '
56500 C BLANKS OUT USED LETTERS
56600 IF(N.EQ.'/')RETURN
56700 IF(N.EQ.'*')RETURN
56800 6 IF(N.EQ.';')RETURN
56900 4 IF(ML.EQ.'O')GO TO 20
57000 RA=43
57100 IF(ML.EQ.MF)RA=50
57200 C ↑↑↑↑↑ MP, MF
57300 GO TO 18
57400 121 IF(ML.EQ.'E')GO TO 120
57500 C ↑↑↑ FERMATA
57600 RA=51
57700 IF(ML.NE.MF)GO TO 18
57800 RA=52
57900 IF(M.EQ.MF)RA=53
58000 C F, FF, FFF -- 51, 52, 53
58100 GO TO 18
58200 CC5 K=14
58300 CC GO TO 8
58400 10 IF(ML.EQ.MC)GO TO 84
58500 IF(ML.NE.MR)GO TO 120
58600 19 K=13
58700 C 'R' FOR ARSIS
58800 GO TO 120
58900 11 IF(ML.EQ.MH)K=12
59000 C THESIS
59100 IF(ML.EQ.MR)K=17
59200 GO TO 120
59300 20 K=17
59400 GO TO 8
59500 21 K=18
59600 GO TO 8
59700 80 IF(ML.EQ.'+')GO TO 85
59800 C FOR /N1 C+ N2/ ETC. -- CRESC. AND DECRESC. LINES.
59900 IF(ML.EQ.'-')GO TO 86
60000 RA=70
60100 C CRESC.
60200 GO TO 18
60300 85 RA=200
60400 GO TO 18
60500 86 RA=199
60600 GO TO 18
60700 81 RA=37
60800 C RIT.
60900 GO TO 18
61000 82 RA=82
61100 C DIM.
61200 GO TO 18
61300 84 RA=80
61400 C ACCEL.
61500 GO TO 18
61600 END
61700
61800 CC NO LONGER CALLED SUBROUTINE DOTS(L,Z,X,RC)
61900 C M=BASIC RHY. NX=NUM OF DOTS
62000 CC COMMON /XRN/RN(4000)
62100 CC RC=4./2.**(Z+2.)
62200 CC IF(RN(L).LT.4)RETURN
62300 CC IF(X.EQ.0)RETURN
62400 C -2=WHOLE, -1=HALF, 0=QUART, 1=EIGHTH, 2=SIXTEENTH, ETC.
62500 CC B=RC
62600 CC DO 100 NN=1,IFIX(X)
62700 CC B=B/2
62800 CC100 RC=RC+B
62900 CC END